(in-package #:abtab)


(defvar *registered-drivers* (make-hash-table :test #'equal)
  "A hash-table of the drivers which have been registered.  The key is
  the scheme name, the value is an assoc-list with at least the
  following entries: scheme-name, class-name and constructor
  function (single argument function that takes a URI and returns an
  initialized driver instance.")

(declaim (special *registered-drivers*))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass column-specifier ()
  ((name
    :accessor colname
    :initform (error "Names are required.")
    :initarg :name
    :documentation "Name of the column")
   (index
    :accessor colindex
    :initform (error "Index is required.")
    :initarg :index
    :documentation "Index of column - for records returned by read-next-record, and for column->index")
   (type
    :accessor coltype
    :initform :any
    :initarg :type
    :documentation "Driver specific type information, not required.")))

(defclass abtab-driver ()
  ((scheme-name
    :accessor scheme-name
    :initform nil
    :initarg :scheme
    :documentation "Name of the encoding, eg: tab, csv, fixed, etc.") 
   (driver-options
    :accessor driver-options
    :initform nil
    :initarg :options
    :documentation "An assoc list of driver specific options.")
   (resource-uri
    :accessor resource-uri
    :initform nil
    :initarg :uri
    :documentation "The URI representing the resource managed by the driver..")
   (columns
    :accessor columns
    :initform (list)
    :initarg :columns
    :documentation "A list of column specifiers.")))

(define-condition duplicate-driver-registered (error)
  ((text :initarg :text :reader text)))

(defun register-driver (scheme driver-name constructor-fn)
  (let ((scheme (lc (->string scheme))))
    (restart-case
      (if (gethash scheme *registered-drivers*)
	  (error 'duplicate-driver-registered :text (format nil "scheme:~a" scheme))
	  (prog1
	    (setf (gethash scheme *registered-drivers*)
		`((,:scheme . ,scheme)
		  (,:name . ,driver-name)
		  (,:constructor . ,constructor-fn))))))))

(defun unregister-driver (scheme)
  "Removes a registered driver based on the schema it is registered to handle."
  (remhash scheme *registered-drivers*))

(defun driver-registered-p (scheme)
  (if (gethash scheme *registered-drivers*)
      t
      nil))

(defun clear-registered-drivers ()
  "Removes all registered drivers."
  (clrhash *registered-drivers*))

(define-condition driver-not-found-for-scheme (error)
  ((text :initarg :text :reader text)))

(defmethod initialize-instance :after ((driver abtab-driver) &rest initargs)
  "The :options are a flat list of pairs, turn them into an assoc list."
  (let ((options (plist-get initargs :options)))
    ;; I want a good logging package for lisp :(
;;     (format t "initialize-instance, :after of abtab-driver:~a options:~a initargs:~a~&"
;; 	    driver options initargs)
    (with-slots (driver-options)
	driver
      (setf driver-options (plist->assoc options)))))

(defgeneric column->index (driver column)
  (:documentation "Find the integer index of a column."))

(defgeneric close-resource (driver))

(defmethod close-resource ((drv abtab-driver))
  (error (format nil "close-resource: not implemented for driver: ~a~&" drv)))

(defmacro with-input-from-uri ((sym uri) &rest body)
  `(let ((,sym (open-resource ,uri)))
     (prog1
	 (progn ,@body)
       (close-resource ,sym))))

(defmacro with-output-to-uri ((sym uri cols) &rest body)
  `(let ((,sym (open-resource ,uri)))
     (prog1
	 (initialize-destination ,sym ,cols)
       (progn ,@body)
       (close-resource ,sym))))

(defgeneric driver-option (driver option-name)
  (:documentation "Get a particular option value by name (symbol)."))

(defmethod driver-option ((drv abtab-driver)
			  (option-name symbol))
  (eassoc option-name (driver-options drv)))

(defun get-driver-info-for-scheme (scheme)
  (aif (gethash (lc (->string scheme)) *registered-drivers*)
       it
       (error 'driver-not-found-for-scheme :text scheme)))

(defmethod column->index ((drv abtab-driver)
			  (column string))
  (let ((pos nil))
    (loop
       for col in (columns drv)
       for ii = 0 then (1+ ii)
       do
	 (progn
	   (when (equal col column)
	     (setf pos ii)
	     (return pos))))
    pos))

(defgeneric index->column (driver index)
  (:documentation "Find the name of a column given an index."))

(defmethod index->column ((drv abtab-driver)
			   (index integer))
  (nth index (columns drv)))


(defgeneric read-next-record (driver)
  (:documentation "Reads the next record from the source (driver) and
  returns it as a vector.  Returns nil if no more records are
  available."))

(defgeneric read-next-record-hash (driver)
  (:documentation "Reads the next records from the source (driver) and
  returns it as a hash.  Returns nil if no more recordsare
  available."))

(defgeneric write-record (driver rec)
  (:documentation "Writes a record (list) to the destination (driver)."))

(defmethod write-record ((driver abtab-driver)
			 (rec list))
  (write-record driver (->vector rec)))

(defgeneric write-hash-record (driver &rest recs)
  (:documentation "Writes one or more records (hashes) to the destination (driver)."))

(defmethod write-record ((drv abtab-driver)
			 (rec simple-vector))
  (error "write-record: Not implemented for driver: ~a." drv))

(defgeneric initialize-destination (driver columns)
  (:documentation "Initialize a driver's destiantion - this is
  destructive to the destination as it prepares it for being written
  to (not appended to)."))

(defmethod initialize-destination ((driver abtab-driver)
				   (columns list))
  (error "initialize-destination: Not implemented for driver: ~a." driver))

(defgeneric reset-for-reading (drv)
  (:documentation "Re-initialize a driver for reading.  This can be
  useful if you want to read from a source more than once, or if
  you've just written to a source and then want to read from it
  without having to construct a new driver."))

(defun get-constructor-fn (scheme)
  (eassoc :constructor (get-driver-info-for-scheme scheme)))

(defun create-driver (scheme res-uri)
  (funcall (get-constructor-fn scheme)
	   res-uri))

(defun open-resource (res-uri)
  (let ((uri (puri:uri res-uri)))
    (create-driver
     (puri:uri-scheme uri)
     uri)))

